RLadies y Data Scientists en Kernel Analytics
Código y datos en https://github.com/intiveda/rladies_textmining
Gran parte de los datos se encuentran no estructurados, es importante conocer técnicas que nos permitan obtener conclusiones a partir de los mensajes que generan nuestras organizaciones, clientes o usuarios.
Hoy aprenderemos algunas técnicas básicas para manipular cadenas de texto y aplicaremos técnicas de NLP a subtítulos para obtener algunas conclusiones.
stringrsubtoolstmtidytexttidyversedplyrdatatableggplot2plotly(opcional)igraphggraphworldcloudPuedes seguir este tutorial de dos formas:
.Rmd en R Studio (para poder ejecutar notebooks necesitarás algunas dependencias)rladies_textmining: setwd("eldirectoriodondehasdescargadoelrepo/rladies_textmining/")c("stringr","subtools","tm","tidytext", "tidyverse","dplyr","data.table","ggplot2","plotly","igraph","ggraph","worldcloud","knit") %in% rownames(installed.packages())
[1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE FALSE FALSE
Las cadenas o strings cumplen un papel importante en las tareas de ETL o preparación de los datos. Una de las librerías esenciales en la materia es string
Stringr es uno de los paquetes diseñados por Hadley Wickham para asistir en las tareas de manipulación de strings:
"" (*usar la comilla simple ' para escapar la doble comilla)"a", números "1", simbolos "&" o todo lo anterior "1a&"NAas.integer(c("a", "&", "123"))
[1] NA NA 123
c(factor("a"), "b", "&",1)
[1] "1" "b" "&" "1"
Concatenar integers y characters, convierte automáticamente los integers en characters.
c(as.character(factor("a")), "b", "&",1)
[1] "a" "b" "&" "1"
# install.packages("stringr")
library(stringr)
Muchas de estas funciones tienne su equivalente en R base, pueden ser más lentas/menos eficientes
str_to_upper(string): convierte un string en mayúsculasstr_to_lower(string): convierte un string en minúsculasstr_to_title(string): capitaliza un stringtemas <- c("Código", "Mujeres", "tecnología", "Informática", "estadística", "Women", "Coders", "Aprendizaje", "automático", "Análisis", "datos", "Visualización", "R-Ladies", "Social", "Coding", "R", "Ciencia", "Programming")
str_to_upper(temas)
[1] "CÓDIGO" "MUJERES" "TECNOLOGÍA" "INFORMÁTICA" "ESTADÍSTICA" "WOMEN"
[7] "CODERS" "APRENDIZAJE" "AUTOMÁTICO" "ANÁLISIS" "DATOS" "VISUALIZACIÓN"
[13] "R-LADIES" "SOCIAL" "CODING" "R" "CIENCIA" "PROGRAMMING"
str_to_lower(temas)
[1] "código" "mujeres" "tecnología" "informática" "estadística" "women"
[7] "coders" "aprendizaje" "automático" "análisis" "datos" "visualización"
[13] "r-ladies" "social" "coding" "r" "ciencia" "programming"
str_to_title(temas)
[1] "Código" "Mujeres" "Tecnología" "Informática" "Estadística" "Women"
[7] "Coders" "Aprendizaje" "Automático" "Análisis" "Datos" "Visualización"
[13] "R-Ladies" "Social" "Coding" "R" "Ciencia" "Programming"
str_c(string, sep = ""): junta varios string en uno solo, es el equivalente a paste(sep = "") o paste0()str_length(string): devuelve la longitud del string, es similar a la función nchar(). Convierte los factores en strings y conserva los NA’sprint(str_length('R-Ladies'))
[1] 8
print(str_length(NA))
[1] NA
str_sub(string, start, end): subsetea un string o un vector de string especificando la posición inicial y la final, es el equivalente en R base a substr(). Por defecto finaliza en el último caracter.print(temas[1:4])
[1] "Código" "Mujeres" "tecnología" "Informática"
str_sub(string = temas[1:4], start=3)
[1] "digo" "jeres" "cnología" "formática"
str_dup(string, times): copia y pega un string un número determinado de vecesstr_dup(string = temas[1:4], times = 3)
[1] "CódigoCódigoCódigo" "MujeresMujeresMujeres"
[3] "tecnologíatecnologíatecnología" "InformáticaInformáticaInformática"
str_trim(string, side = c("both", "left", "rigth")): elimina los espacios vacíos, por defecto toma el valor both. Mejor evitar gsub(" ", "", string)
str_pad(string, width, side = c("left", "both", "right"), pad = " ")): añade a strings espacios en blanco para igualarlos en longitud, especialmente útil para añadir 0 a números.
Las expresiones regulares ( regular expressions, regex, pattern matching) son un lenguaje usado para parsear y manipular texto. Se usan comúnmente para hacer operaciones de búsqueda y reemplazo y para validar si un texto está bien formado.
Las expresiones regulares son un mundo en si mismo, aquí tienes una pequeña chuleta : https://www.rstudio.com/wp-content/uploads/2016/09/RegExCheatsheet.pdf
rcosas = c("baseR", "R-Ladies", "Rmeetup", "Rmarkdown", "stringR")
str_detect(rcosas, pattern = "^R")
[1] FALSE TRUE TRUE TRUE FALSE
rcosas[str_detect(rcosas, pattern = "^R")]
[1] "R-Ladies" "Rmeetup" "Rmarkdown"
rcosas[str_detect(rcosas, pattern = "R")]
[1] "baseR" "R-Ladies" "Rmeetup" "Rmarkdown" "stringR"
cleanR <- c("tidyverse", "tidyr","dplyr", "ggplot2", "tidytext", "purrr")
str_locate(cleanR, "tidy")
start end
[1,] 1 4
[2,] 1 4
[3,] NA NA
[4,] NA NA
[5,] 1 4
[6,] NA NA
str_extract(string, pattern) o str_extract_all(): busca la palabra exacta (normalmente se utiliza con expresiones regulares concatenadas)str_match(string, pattern) o str_match_all(): es una función equivalente pero devuelve una matrizstr_match(c("12345678", "12587465", "dni desconocido"), pattern = "[1-9]{8}")
[,1]
[1,] "12345678"
[2,] "12587465"
[3,] NA
str_match_all(c("12345678", "12587465", "dni desconocido"), pattern = "[1-9]{8}")
[[1]]
[,1]
[1,] "12345678"
[[2]]
[,1]
[1,] "12587465"
[[3]]
[,1]
str_replace(string, pattern, replacement): reemplaza la primera instancia, str_replace_all para reemplazarlas todasstr_replace(c("castanya", "otonyo", "veronyo", "anyo", "nyonyo"), pattern = "ny", replacement = "ñ")
[1] "castaña" "otoño" "veroño" "año" "ñonyo"
str_replace_all(c("castanya", "otonyo", "veronyo", "anyo", "nyonyo"), pattern = "ny", replacement = "ñ")
[1] "castaña" "otoño" "veroño" "año" "ñoño"
str_split(string, pattern): separa una cadena en un vector, str_split_fixed(string, pattern, n) lo hace en un número n determinado de elementosprint(str_split("Eres muy chu chu chuli",pattern = " "))
[[1]]
[1] "Eres" "muy" "chu" "chu" "chuli"
print(length(str_split("Eres muy chu chu chuli",pattern = " ")[[1]]))
[1] 5
La librería subtools permite leer archivos .str y .sub, así como organizar cada diálogo en un data frame. Los archivos han de estar organizados en directorios por temporadas y cada uno ha de estar nombrado como S01xE01 para que se parsee correctamente el número de temporada y de episodio.
Nos centraremos en las 9 primeras temporadas de los Simpsons. Si descargamos la puntuación y representamos gráficamente el promedio del score por temporada, se observa un claro descenso a partir de la 10. Por otro lado son las temporadas que mejor conocemos gracias a sus numerosas repeticiones :)
knitr::include_graphics("./images/ratings.png",dpi = 100)
A continuación leemos los subtítulos ( en inglés ) de las 9 primeras temporadas de los Simpsons.
library(subtools)
a <- read.subtitles.serie(dir = "./The Simpsons/")
Read: 9 seasons, 205 episodes
df <- subDataFrame(a)
df <- df[complete.cases(df), ]
str(df)
'data.frame': 58066 obs. of 8 variables:
$ ID : chr "<U+FEFF>1""| __truncated__ "2" "3" "4" ...
$ Timecode.in : chr "00:00:00.042" "00:00:08.759" "00:00:10.761" "00:00:15.557" ...
$ Timecode.out: chr "00:00:00.042" "00:00:10.677" "00:00:13.180" "00:00:17.851" ...
$ Text : chr "23.976" "Ooh! Careful, Homer!" "There's no time. We're late." "O little town of Bethlehem" ...
$ season : chr "season 1" "season 1" "season 1" "season 1" ...
$ season_num : num 1 1 1 1 1 1 1 1 1 1 ...
$ episode_num : num 1 1 1 1 1 1 1 1 1 1 ...
$ serie : chr "The Simpsons" "The Simpsons" "The Simpsons" "The Simpsons" ...
Una primera opción es emplear la librería tm para nuestro análisis. La función tm_map nos va a permitir preparar nuestor documento para el análisis:
library(tm)
c <- tmCorpus(a)
c <- tm_map(c, content_transformer(tolower))
c <- tm_map(c, removePunctuation)
c <- tm_map(c, removeNumbers)
c <- tm_map(c, removeWords, stopwords("english"))
c <- tm_map(c, stripWhitespace)
c
<<SimpleCorpus>>
Metadata: corpus specific: 1, document level (indexed): 4
Content: documents: 205
El segundo paso, una vez preparado nuestro corpus, será el de construir la matriz de términos documentos. Para simplificar el análisis cada temporada constituirá un documento. De esta forma obtenemos para cada término la frecuencia por temporada.
TDM <- TermDocumentMatrix(c)
TDM <- as.matrix(TDM)
vec.season <- c(rep(x = 1,13), rep(2, 22), rep(3,24), rep(4,22), rep(5,24), rep(6,25), rep(7,25),rep(8,25), rep(9,25)) #episodios por temp
TDM.season <- t(apply(TDM, 1, function(x) tapply(x, vec.season, sum)))
colnames(TDM.season) <- paste0("S_", unique(vec.season))
head(TDM.season)
Terms S_1 S_2 S_3 S_4 S_5 S_6 S_7 S_8 S_9
able 6 4 3 0 6 7 4 2 4
aboard 1 1 2 2 2 2 2 1 1
acts 1 1 1 0 0 1 0 0 1
adult 1 3 2 0 3 3 1 1 1
affecting 1 0 0 0 0 0 0 0 0
afford 5 8 5 1 2 4 8 6 1
A continuación representamos en una nube de términos dichas frecuencias: el tamaño indica el número de repeticiones y el color la temporada en la que más repeticiones presenta. La posición del término respecto de la etiqueta de temporada indica también la frecuencia por temporada.
library(wordcloud)
set.seed(100)
comparison.cloud(TDM.season, title.size = 1, max.words = 200, random.order = T)
La librería tidytext nos permite realizar operaciones como tf (frecuencia de términos) o tf_idf (frecuencia de término - frecuencia inversa de documento) con mayor agilidad.
De nuevo vamos a preparar el nuestros diálogos para el análisis eliminado las stopwords.
library(tidytext)
library(tidyverse)
data(stop_words)
tidy_df <- df %>%
unnest_tokens(word, Text) %>%
dplyr::anti_join(stop_words)
Eliminamos además aquellas “palabras” constituidas exclusivamente por números y la palabra simpson.
library(data.table)
tidy_df <- as.data.table(tidy_df)
tidy_df <- tidy_df[is.na(as.numeric(word))]
tidy_df <- tidy_df[word != 'simpson']
Con nuestro data set limpio podemos representar en un gráfico de barras la frecuencia de términos. Lo que haremos será:
count)library(ggplot2)
tidy_df %>% group_by(season) %>%
count(word, sort = FALSE) %>%
top_n(15) %>%
ggplot(aes(reorder(word,n), n, fill = season)) +
geom_col() +
coord_flip() +
facet_wrap(~season, scales = "free_y") +
labs(x = NULL) +
guides(fill = FALSE) +
scale_fill_brewer(palette = "Set1")
Selecting by n
Ahora que disponemos de la frecuencia podemos analizar la evolución en sus apariciones / tramas de cada personaje: + calculamos la frecuencia para todos los términos, no solo el top 15 + creamos dos listas, la familia Simpson y otros personajes relevantes de la trama + representamos ambas series series temporales
#install.packages('plotly')
require(plotly)
tidy_tf <- tidy_df %>% group_by(season) %>%
count(word, sort = TRUE)
tidy_tf <- as.data.table(tidy_tf)
simpson_family <- c('homer', 'bart', 'lisa', 'maggie', 'marge', 'patty','selma')
other_characters <- c('moe', 'ned', 'barney', 'modd', 'itchy', 'scratchy', 'krusty', 'burns', 'lenny', 'carl', 'edna', 'nelson', 'apu', 'milhouse', 'ralph', 'skinner', 'bob')
myplot <- ggplot(tidy_tf[tidy_tf$word %in% simpson_family], aes(x=season, y=n, group=word)) +
geom_line(aes(color=word), size=1.25)+
geom_point(aes(color=word))
ggplotly(myplot)
myplot <- ggplot(tidy_tf[tidy_tf$word %in% other_characters], aes(x=season, y=n, group=word)) +
geom_line(aes(color=word), size=0.75)+
geom_point(aes(color=word))
ggplotly(myplot)
También podemos obtener y representar los bigramas (conjunto de 2 términos) y sus frecuencias. Se representan en forma de grafo los más comunes (aquellos que aparecen al menos 7 veces en una misma temporada)
library(tidyr)
library(igraph)
library(tidytext)
bigram_graph <- df %>%
unnest_tokens(bigram, Text, token = "ngrams", n = 2) %>%
separate(bigram, c("word1", "word2"), sep = " ") %>%
filter(!word1 %in% stop_words$word) %>%
filter(!word2 %in% stop_words$word) %>%
group_by(season) %>%
count(word1, word2, sort = TRUE) %>%
select(word1, word2, season, n) %>%
filter(n > 7) %>%
graph_from_data_frame()
# str(bigram_graph)
library(ggraph)
set.seed(2017)
ggraph(bigram_graph, layout = "fr") +
geom_edge_link() +
geom_node_point() +
geom_node_text(aes(label = name), vjust = 1, hjust = 1)
a <- grid::arrow(type = "closed", length = unit(.15, "inches"))
ggraph(bigram_graph, layout = "fr") +
geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
arrow = a, end_cap = circle(.07, 'inches')) +
geom_node_point(color = "lightblue", size = 5) +
geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
theme_void()
También podemos realizar tf_idf sobre nuestro corpus para localizar las palabras más relevantes, en general y por temporada
library(dplyr)
tf_idf_df <- tidy_df %>%
count(season, word, sort = TRUE) %>%
bind_tf_idf(word, season, n)
tf_idf_df <- tf_idf_df[order(-tf_idf_df$tf_idf),]
tf_idf_df %>%
top_n(20) %>%
ggplot(aes(word, tf_idf, fill = season)) +
geom_col() +
labs(x = NULL, y = "tf-idf") +
coord_flip()
Selecting by tf_idf
tf_idf_df %>%
group_by(season) %>%
top_n(8) %>%
ungroup %>%
ggplot(aes(reorder(word, tf_idf), tf_idf, fill = season)) +
geom_col(show.legend = FALSE) +
labs(x = NULL, y = "tf-idf") +
facet_wrap(~season, ncol = 2, scales = "free") +
coord_flip()
Selecting by tf_idf
Valorar como positivo o negativo un mensaje es una tarea compleja, que requiere no sólo conocer el significado de las palabras sino también contextualizarlas, conocer la entonación en que se produce el mensaje, etc.
En este caso vamos a realizar una aproximación mucho más simple, que es la de considerar el texto como la combinación de palabras individuales y el sentimiento como la suma del sentimiento asociado a cada una de las palabras. Para ello tidytextnos ofrece tres posibles datasets (lexicon) de sentimientos: + AFINN from Finn Årup Nielsen (-5, 5), + bing from Bing Liu and collaborators(“positive” / “negative”) + nrc from Saif Mohammad and Peter Turney (“yes” / “no”).
Todos ellos basados en unigramas.
library(tidyr)
simpson_sentiment <- tidy_df %>%
inner_join(get_sentiments("bing")) %>%
count(season_episode, sentiment) %>%
spread(sentiment, n, fill = 0) %>%
mutate(sentiment = positive - negative)
Joining, by = "word"
head(simpson_sentiment,3)
afinn <- tidy_df %>%
inner_join(get_sentiments("afinn")) %>%
group_by(season_episode) %>%
summarise(sentiment = sum(score)) %>%
mutate(method = "AFINN")
Joining, by = "word"
afinn <- as.data.table(afinn)
afinn[, season:= str_sub(season_episode,start = 1, end = 2)]
afinn[, season:= str_replace(season, "S", "Season ")]
afinn[, episode:= str_sub(season_episode,start = 4, end = 6)]
ggplot(afinn, aes(episode, sentiment, fill = season)) +
geom_col(show.legend = FALSE) +
facet_wrap(~season, ncol = 2, scales = "free_x")